home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ANSI.SWG / 0024_Another ANSI Driver.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-21  |  7KB  |  273 lines
  1. {
  2. From: STEFAN XENOS
  3. Subj: ANSI.PAS
  4.  
  5. Those routines have been posted several times, so here's some different code
  6. which serves a similar purpose. I got it from the 1992 ZipNav CD, and
  7. have done some slight debugging. Here it is: }
  8.  
  9. USES crt;
  10. CONST
  11.   FF = #12;
  12.   ESC = #27;
  13. VAR Ch : CHAR;
  14.  C : CHAR;
  15.  i , FGcolor, BGcolor, CursorX, CursorY : INTEGER;
  16.         escape_mode, lightcolor : BOOLEAN;
  17.         escape_number : BYTE;
  18.         escape_register : ARRAY [1..50] OF BYTE;
  19.         escape_str : STRING [80];
  20.  
  21. AnsiFile : TEXT;
  22.  
  23. (****************************************************************************)
  24. (*                             PROCESS ESCAPE                               *)
  25. (****************************************************************************)
  26. PROCEDURE
  27.       wrt ( c : CHAR );
  28.    BEGIN
  29.  
  30.       CASE c OF
  31.            FF :  CLRSCR;
  32.           ELSE   WRITE (c);
  33.       END;
  34.    END;
  35.  
  36.  PROCEDURE
  37.       set_graphics;
  38.    VAR
  39.       i     : INTEGER;
  40.       FG, BG : INTEGER;
  41.    BEGIN
  42.       FG := FGcolor;
  43.       BG := BGcolor;
  44.       FOR i := 1 TO escape_number DO BEGIN
  45.          CASE escape_register [i] OF
  46.             0 : lightcolor := FALSE;
  47.             1 : lightcolor := TRUE;
  48.             5 : FG := FG + blink;
  49.             7 : BEGIN
  50.                    FG := BG;
  51.                    BG := FG;
  52.                 END;
  53.            30 : FG := black;
  54.            31 : FG := red;
  55.            32 : FG := green;
  56.            33 : FG := brown;
  57.            34 : FG := blue;
  58.            35 : FG := magenta;
  59.            36 : FG := cyan;
  60.            37 : FG := white;
  61.            40 : BG := black;
  62.            41 : BG := red;
  63.            42 : BG := green;
  64.            43 : BG := yellow;
  65.            44 : BG := blue;
  66.            45 : BG := magenta;
  67.            46 : BG := cyan;
  68.            47 : BG := white;
  69.          ELSE
  70.             ;
  71.          END;
  72.       END;
  73.       IF (lightcolor) AND (fg < 8) THEN
  74.          fg := fg + 8;
  75.       IF (lightcolor = FALSE) AND (fg > 7) THEN
  76.          fg := fg - 8;
  77.       TEXTCOLOR ( FG );
  78.       TEXTBACKGROUND ( BG );
  79.       escape_mode := FALSE;
  80.    END;
  81.  
  82.    PROCEDURE MoveUp;
  83.    BEGIN
  84.      IF escape_register [1] < 1 THEN
  85.         escape_register [1] := 1;
  86.      GOTOXY (WHEREX, WHEREY - (Escape_Register [1]) );
  87.    END;
  88.  
  89.    PROCEDURE MoveDown;
  90.    BEGIN
  91.      IF escape_register [1] < 1 THEN
  92.         escape_register [1] := 1;
  93.      GOTOXY (WHEREX, WHEREY + (Escape_Register [1]) );
  94.    END;
  95.  
  96.    PROCEDURE MoveForeward;
  97.    BEGIN
  98.      IF escape_register [1] < 1 THEN
  99.         escape_register [1] := 1;
  100.      GOTOXY (WHEREX + (Escape_Register [1]), WHEREY);
  101.    END;
  102.  
  103.    PROCEDURE MoveBackward;
  104.    BEGIN
  105.      IF escape_register [1] < 1 THEN
  106.         escape_register [1] := 1;
  107.      GOTOXY (WHEREX - (Escape_Register [1]), WHEREY);
  108.    END;
  109.  
  110.    PROCEDURE SaveCursorPos;
  111.    BEGIN
  112.       CursorX := WHEREX;
  113.       CursorY := WHEREY;
  114.    END;
  115.  
  116.    PROCEDURE RestoreCursorPos;
  117.    BEGIN
  118.       GOTOXY (CursorX, CursorY);
  119.    END;
  120.  
  121.    PROCEDURE addr_cursor;
  122.    BEGIN
  123.       CASE escape_number OF
  124.          0 : BEGIN
  125.                 escape_register [1] := 1;
  126.                 escape_register [2] := 1;
  127.              END;
  128.          1 : escape_register [2] := 1;
  129.       ELSE
  130.          ;
  131.       END;
  132.       IF escape_register [1] = 25 THEN
  133.          GOTOXY (escape_register [2], 24)
  134.       ELSE
  135.          GOTOXY (escape_register [2], escape_register [1]);
  136.       escape_mode := FALSE;
  137.    END;
  138.  
  139.    PROCEDURE clear_scr;
  140.    BEGIN
  141.       IF ( escape_number = 1 )  AND  ( escape_register [1] = 2 ) THEN
  142.          CLRSCR;
  143.       escape_mode := FALSE;
  144.    END;
  145.  
  146.    PROCEDURE clear_line;
  147.    BEGIN
  148.       IF ( escape_number = 1 )  AND  ( escape_register [1] = 0 ) THEN
  149.          CLREOL;
  150.       escape_mode := FALSE;
  151.    END;
  152.  
  153.    PROCEDURE process_escape ( c : CHAR );
  154.    VAR
  155.       i    : INTEGER;
  156.       ch   : CHAR;
  157.    BEGIN
  158.       c := UPCASE (c);
  159.       CASE c OF
  160.           '['
  161.              : EXIT;
  162.          'F', 'H'
  163.              : BEGIN
  164.                   addr_cursor;
  165.                   Escape_mode := FALSE;
  166.                   EXIT;
  167.                END;
  168.          'J' : BEGIN
  169.                   clear_scr;
  170.                   Escape_mode := FALSE;
  171.                   EXIT;
  172.                END;
  173.  
  174.          'K' : BEGIN
  175.                   clear_line;
  176.                   Escape_mode := FALSE;
  177.                   EXIT;
  178.                END;
  179.          'M' : BEGIN
  180.                   set_graphics;
  181.                   Escape_mode := FALSE;
  182.                   EXIT;
  183.  
  184.                END;
  185.          'S' : BEGIN
  186.                  SaveCursorPos;
  187.                   Escape_mode := FALSE;
  188.                  EXIT;
  189.                END;
  190.          'U' : BEGIN
  191.                  RestoreCursorPos;
  192.                  Escape_Mode := FALSE;
  193.                  EXIT;
  194.                END;
  195.          'A' : BEGIN
  196.                  MoveUp;
  197.                  Escape_mode := FALSE;
  198.                  EXIT;
  199.                END;
  200.          'B' : BEGIN
  201.                  MoveDown;
  202.                  Escape_mode := FALSE;
  203.                  EXIT;
  204.                END;
  205.          'C' : BEGIN
  206.                 MoveForeward;
  207.                  Escape_mode := FALSE;
  208.                 EXIT;
  209.                END;
  210.          'D' : BEGIN
  211.                 MoveBackward;
  212.                  Escape_mode := FALSE;
  213.                 EXIT;
  214.                END;
  215.       END;
  216.       ch := UPCASE ( c );
  217.       escape_str := escape_str + ch;
  218.       IF ch IN [ 'A'..'G', 'L'..'P' ] THEN EXIT;
  219.       IF ch IN [ '0'..'9' ] THEN BEGIN
  220.          escape_register [escape_number] := (escape_register [escape_number] * 10) + ORD ( ch ) - ORD ( '0' );
  221.          EXIT;
  222.       END;
  223.       CASE ch OF
  224.          ';', ',' : BEGIN
  225.                        escape_number := escape_number + 1;
  226.                        escape_register [escape_number] := 0;
  227.                     END;
  228.          'T',  '#', '+', '-', '>', '<', '.'
  229.                   : ;
  230.       ELSE
  231.          escape_mode := FALSE;
  232.          FOR i := 1 TO LENGTH ( escape_str ) DO
  233.             wrt ( escape_str [i] );
  234.       END;
  235.    END;
  236. (**************************************************************************)
  237. (*                             SCREEN HANDLER                             *)
  238. (**************************************************************************)
  239.    PROCEDURE scrwrite ( c : CHAR );
  240.    VAR
  241.       i  : INTEGER;
  242.    BEGIN
  243.       IF c = ESC THEN BEGIN
  244.          IF escape_mode THEN BEGIN
  245.             FOR i := 1 TO LENGTH ( escape_str ) DO
  246.                wrt ( escape_str [i] );
  247.          END;
  248.          escape_str := '';
  249.          escape_number := 1;
  250.          escape_register [escape_number] := 0;
  251.          escape_mode := TRUE;
  252.       END
  253.       ELSE
  254.          IF escape_mode THEN
  255.             process_escape (c)
  256.          ELSE
  257.             wrt ( c );
  258.    END;
  259. BEGIN
  260. Escape_Str := '';
  261. FGColor := White;BGColor := BLACK;
  262. Escape_Mode := TRUE;
  263. CLRSCR;
  264. ASSIGN (AnsiFile, '\modem\host.ans');
  265. RESET (AnsiFile);
  266. WHILE NOT EOF (AnsiFile) DO BEGIN
  267.   READ (AnsiFile, ch);
  268.   DELAY (1);
  269.   ScrWrite (Ch);
  270. END;
  271.  
  272. END.
  273.